home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / tex / rpsort.zip / RPTAB.PAS < prev   
Pascal/Delphi Source File  |  1991-08-16  |  21KB  |  533 lines
  1.  
  2. {$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,R-,S-,V-,X-}
  3.  
  4. program RPTab;
  5.  
  6.  
  7. {-------------------------Syntax Of RPTAB ----------------------------------}
  8.  
  9. { RPTAB input-filespec  output-filespec  [tabstop...]
  10.  
  11.  The input is a file containing tabs to be expanded.  The contents of the
  12.  output file will be the same except that all tabs will have been expanded
  13.  to the appropriate number of spaces.
  14.  
  15.  If you don't specify any tab stops, the default tab stops are at columns
  16.  1, 9, 17, 25, 33 and so on at intervals of 8 columns.  If you specify tab
  17.  stops, they must be a sequence of integers each greater than the preceding
  18.  one.  The first tab stop is always at column 1 and you need not specify it.
  19.  RPTAB follows the rule that the interval between the last two tab stops,
  20.  you specify, implies subsequent tab stops at the same interval.  For
  21.  example, the command:
  22.  
  23.     RPTAB  MYTABS.DAT  MYSPACES.DAT  6 15 27
  24.  
  25.  tells RPTAB that the tab stops are at columns 1, 6, 15, 27, 39, 51 and etc.
  26.  The interval of 12 between 15 and 27 is propagated to subsequent tab stops.}
  27.  
  28.  
  29.  {-------------- Const, Type and Variable Declarations ---------------------}
  30.  
  31.   const
  32.     BuffSize = 32768;
  33.  
  34.   type
  35.     TabArray = array[1..50] of Word;
  36.     DataArray = array[0..BuffSize-1] of Char;
  37.     DataPtr = ^DataArray;
  38.  
  39.   var
  40.     Tab : TabArray;         {This array holds the tab stops to be used.}
  41.     TabCt : Byte;           {Number of tab stops specified or implied.}
  42.     IpFile, OpFile : file;
  43.     IpPtr, OpPtr : DataPtr; {Pointers to buffers for input and output files.}
  44.     IpNext, OpNext : Word;  {Offset of next byte in input and output buffers.}
  45.     IpRead, OpWritten : Word; {Actual bytes read/written by each I/O request.}
  46.     MoreData : Boolean;      {Set to False at end of input file.}
  47.     Column : Word;          {Current column in current output line.}
  48.     FillCt : Word;          {Spaces required to fill out tab.}
  49.  
  50.  
  51. {----------------------- function GotFiles ---------------------------------}
  52.  
  53.  {Function GotFiles returns the value True if it successfully opens both the
  54.  input and output files.  Otherwise it returns False.}
  55.  
  56.   function GotFiles(var IpFile, OpFile : file) : Boolean;
  57.     var
  58.       HoldIOResult : Word;
  59.  
  60.     begin
  61.  
  62.  {Must specify two or more parameters including input and output files.}
  63.       if ParamCount < 2 then
  64.         begin
  65.           Writeln('Must specify an input file and an output file.');
  66.           GotFiles := False;
  67.           exit
  68.         end;
  69.  
  70.  {Setting FileMode=0 tells the Reset procedure to open file as read only.}
  71.       FileMode := 0;
  72.  
  73.       Assign(IpFile, ParamStr(1));
  74.       Assign(OpFile, ParamStr(2));
  75.  
  76.  {If Reset fails, display error message and set function result to False.}
  77.       Reset(IpFile, 1);
  78.       HoldIOResult := IOResult;
  79.       if HoldIOResult > 0 then
  80.         begin
  81.           case HoldIOResult of
  82.             2 :   Writeln('Input file not found: ', ParamStr(1));
  83.             3 :   Writeln('Invalid input file spec: ', ParamStr(1));
  84.             else  Writeln('Unable to open input file: ', ParamStr(1));
  85.           end;
  86.           GotFiles := False;
  87.           Exit
  88.         end;
  89.  
  90.  {If Rewrite fails, display error message and set function result to False.}
  91.       Rewrite(OpFile, 1);
  92.       HoldIOResult := IOResult;
  93.       if HoldIOResult > 0 then
  94.         begin
  95.           case HoldIOResult of
  96.             3 :   Writeln('Invalid output file spec: ', ParamStr(2));
  97.             else  Writeln('Unable to open output file: ', ParamStr(2));
  98.           end;
  99.           GotFiles := False;
  100.           Exit
  101.         end;
  102.  
  103.  {If both files opened successfully, return function result True.}
  104.       GotFiles := True
  105.  
  106.     end;
  107.  
  108.  
  109.  {------------------- procedure CloseDelete --------------------------------}
  110.  
  111.   procedure CloseDelete;
  112.     begin
  113.       Close(IpFile);
  114.       Close(OpFile);
  115.       Erase(OpFile)
  116.     end;
  117.  
  118.  
  119.  {--------------------- function GotTabs -----------------------------------}
  120.  
  121.  {Function GotTabs returns the value True if it successfully creates the
  122.    array of tab stops.  Otherwise it returns False.}
  123.  
  124.   function GotTabs(var Tab : TabArray; var TabCt : Byte) : Boolean;
  125.  
  126.     var
  127.       Temp : LongInt;
  128.       Code : Integer;
  129.       Start, I : Byte;
  130.     begin
  131.  
  132.  
  133.  {The default tab stops are at columns 1, 9, 17, 25 (and so on at intervals
  134.   of eight columns).  Internally, RPTab represents these as 0, 8, 16, 24 etc.
  135.   Since the interval between the last two explicit tab stops is propagated to
  136.   subsequent tab stops, EXPTABS sets two tab stops at columns 0 and 8 in the
  137.   Tab array and sets TabCT = 2.  It also sets GotTabs to True on the
  138.   assumption that tab stops will be OK.}
  139.  
  140.       Tab[1] := 0;
  141.       Tab[2] := 8;
  142.       TabCt  := 2;
  143.       GotTabs := True;
  144.  
  145.  
  146.  {If ParamCount is 2 then only files were specified and no tab stops.  Thus,
  147.   RPTAB sticks with the default tab stops set above.}
  148.  
  149.       if ParamCount = 2 then Exit;
  150.  
  151.  
  152.  {If the first specified tab stop (ParamStr(3)) is a valid integer and equals
  153.   1, then having already set the first tab stop at 1, we will start with the
  154.   4th parameter.}
  155.  
  156.       Val(ParamStr(3), Temp, Code);
  157.       if (Code = 0) and (Temp = 1) then
  158.         if ParamCount > 3
  159.           then Start := 4
  160.           else Exit
  161.       else Start := 3;
  162.       TabCt := ParamCount - Start + 2;
  163.  
  164.  
  165.  {Get each tab stop in turn.  Check that it is an integer between 1 and
  166.   65535 and that it is greater than the previous tab stop.  If not, display
  167.   an error message and return with GotTabs = False.}
  168.  {If a tab stop is OK, decrement it by 1 and store it in the corresponding
  169.   Tab array bucket.  I decrement it because internally I count columns
  170.   starting with zero while externally I count them starting with one.}
  171.  
  172.       for I := 2 to TabCt do
  173.         begin
  174.           Val(ParamStr(Start + I - 2), Temp, Code);
  175.           if (Code <> 0) or (Temp < 1) or (Temp > 65535) then
  176.             begin
  177.               Writeln('Tab stop must be integer between 1 and 65535: ',
  178.                       ParamStr(Start + I - 2));
  179.               GotTabs := False;
  180.               CloseDelete;
  181.               Exit
  182.             end;
  183.           if Tab[I - 1] >= (Temp - 1) then
  184.             begin
  185.               Writeln('Tab stop at ', Temp, ' must exceed the ',
  186.                       'previous tab stop at ', Tab[I - 1]+1, '.');
  187.               GotTabs := False;
  188.               CloseDelete;
  189.               Exit
  190.             end;
  191.           Tab[I] := Temp - 1
  192.         end
  193.     end;
  194.  
  195.  
  196.  {-------------------- function  ReadOk ------------------------------------}
  197.  
  198.  {Function ReadOk returns the value True if it successfully reads from the
  199.   input file.  Otherwise it displays an error message and returns False.}
  200.  
  201.   function ReadOK(var IpFile : file; var Buff : DataArray; BuffSize : Word;
  202.                   var IpRead : Word) : Boolean;
  203.     var
  204.       HoldIOResult : Word;
  205.     begin
  206.       BlockRead(IpFile, Buff, BuffSize, IpRead);
  207.       HoldIOResult := IOResult;
  208.       if HoldIOResult <> 0 then
  209.         begin
  210.           Writeln('Error reading input file.');
  211.           ReadOK := False;
  212.           CloseDelete
  213.         end
  214.       else ReadOK := True
  215.     end;
  216.  
  217.  
  218.  {---------------------- function WriteOK ----------------------------------}
  219.  
  220.  {Function WriteOk returns the value True if it successfully writes to the
  221.   output file.  Otherwise it displays an error message and returns False.}
  222.  
  223.   function WriteOK(var OpFile : file; var Buff : DataArray; WriteLen : Word;
  224.                    var OpWritten : Word) : Boolean;
  225.     var
  226.       HoldIOResult : Word;
  227.     begin
  228.       WriteOK := True;
  229.       BlockWrite(OpFile, Buff, WriteLen, OpWritten);
  230.       HoldIOResult := IOResult;
  231.       if HoldIOResult <> 0 then
  232.         begin
  233.           Writeln('Error writing output file.');
  234.           CloseDelete;
  235.           WriteOk := False
  236.         end;
  237.       if OpWritten <> WriteLen then
  238.         begin
  239.           Writeln('Ran out of space on disk writing output file.');
  240.           CloseDelete;
  241.           WriteOk := False
  242.         end;
  243.     end;
  244.  
  245.  
  246.  {---------------